home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbmouse.zip / MOUSE.BAS < prev    next >
BASIC Source File  |  1993-07-01  |  16KB  |  373 lines
  1.  
  2.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  3.     '                                     ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,    '
  4.     ' Robert Seace                        ; QB Mouse Support Routines ;    '
  5.     ' RFD 2  Box 229                      '''''''''''''''''''''''''''''    '
  6.     ' Littleton, NH  03561                  Feel free to distribute!       '
  7.     '                                                                      '
  8.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  9.     '                        Filename: MOUSE.BAS                           '
  10.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  11.       
  12.     ' Note: To use these routines, you must either link in the compiled
  13.     '       object code (MOUSE.OBJ) and the QB.LIB library, or simply use
  14.     '       the included MOUSE.LIB library.  At the linker's prompt for
  15.     '       libraries, type "mouse.lib" (actually, I would probably type
  16.     '       "bcom45.lib+mouse.lib", which would also link in the compile
  17.     '       time library to produce a stand-alone executable file, as well).
  18.     '       Using this MOUSE.LIB method, you need not bother to link in the
  19.     '       MOUSE.OBJ object code along with your own compiled object code,
  20.     '       nor do you need to link in the QB.LIB library, as it is already
  21.     '       contained within the MOUSE.LIB library.  Simply include MOUSE.BI
  22.     '       at the top of your code (use the "'$include: 'mouse.bi'"
  23.     '       metacommand; note that it must be within a comment, and there
  24.     '       should be only spaces/tabs next to the dollar sign, unless it
  25.     '       is put directly next to the FIRST single-quote (apostrophe)
  26.     '       marking the comment), then compile your code, and link it with
  27.     '       the MOUSE.LIB library, and you'll be all set.
  28.     '       If you want to use the mouse functions within the QB environment,
  29.     '       use the MOUSE.QLB QuickLibrary (start QB using the /L parameter:
  30.     '       "qb /L mouse").
  31.     
  32.     '$INCLUDE: 'mouse.bi'
  33.  
  34.     DIM SHARED inreg AS RegType   ' Input Registers; used in CALL INTERRUPT
  35.     DIM SHARED outreg AS RegType  ' Output Registers; used in CALL INTERRUPT
  36.     DIM SHARED inregx AS RegTypeX  ' Extended Input Registers w/ segment
  37.     DIM SHARED outregx AS RegTypeX ' Extended Output Registers w/ segment
  38.  
  39.     ' Internal variables used by various mouse functions
  40.     DIM SHARED mINIT AS INTEGER, mGRAPHICS AS INTEGER
  41.     DIM SHARED mXlast AS INTEGER, mYlast AS INTEGER
  42.     mINIT = 0
  43.     mGRAPHICS = 0
  44.     mXlast = 0
  45.     mYlast = 0
  46.  
  47.     FUNCTION MouseButton (event AS MouseEvent, debounce AS INTEGER)
  48.     ' ---------------------------=< MouseButton >=-------------------------
  49.     ' Detects whether or not a mouse button has been pressed.  Works the
  50.     ' same way as MouseMove (returns TRUE and updates passed MouseEvent
  51.     ' structure if button pressed, else returns FALSE).  The second
  52.     ' parameter of the function determines whether or not the buttons will
  53.     ' be "debounced" after reading a press.  Debouncing means that the
  54.     ' function will wait until the button is no longer pressed anymore
  55.     ' before it returns to the caller.  This is a good thing to use,
  56.     ' because a single click of a mouse button can often produce several
  57.     ' button-press events, due to the sensitivity of the mouse buttons.
  58.     ' Using the debounce option (passing TRUE, or any non-zero value, as
  59.     ' the second parameter) eliminates these extra button-press events and
  60.     ' prevents possible problems with thinking the user has clicked more
  61.     ' than he has.  However, I left the option of not debouncing because
  62.     ' it is possible you may want to keep track of held-down buttons (for
  63.     ' dragging the mouse through pull-down menus, or other such things
  64.     ' where the user must hold down the button); in this case, simply pass
  65.     ' FALSE (0) as the second parameter.
  66.  
  67.         IF mINIT = 0 THEN           ' Not initialized/available
  68.             MouseButton = 0
  69.             EXIT FUNCTION
  70.         END IF
  71.  
  72.         inreg.ax = 3
  73.         CALL INTERRUPT(&H33, inreg, outreg)     ' Get pos/button info
  74.         IF outreg.bx > 0 THEN           ' a button(s) is pressed
  75.             event.buttons = outreg.bx
  76.             IF mGRAPHICS = 0 THEN       ' text mode
  77.                 outreg.cx = INT(outreg.cx / 8) + 1
  78.                 outreg.dx = INT(outreg.dx / 8) + 1
  79.             ELSEIF mGRAPHICS = 1 THEN   ' graphics mode 1
  80.                 outreg.cx = INT(outreg.cx / 2)
  81.             END IF
  82.             event.x = outreg.cx
  83.             event.y = outreg.dx
  84.             mXlast = outreg.cx
  85.             mYlast = outreg.dx
  86.             IF debounce <> 0 THEN       ' User wants to debounce buttons
  87.                 WHILE outreg.bx > 0     ' While a button(s) is pressed...
  88.                     CALL INTERRUPT(&H33, inreg, outreg) ' get pos/button info
  89.                 WEND
  90.             END IF
  91.             MouseButton = NOT 0
  92.         ELSE
  93.             MouseButton = 0
  94.         END IF
  95.     END FUNCTION
  96.  
  97.     SUB MouseGetInfo (event AS MouseEvent)
  98.     ' --------------------------=< MouseGetInfo >=--------------------------
  99.     ' This subroutine gets the position of mouse pointer (actual screen
  100.     ' position, dependent upon screen mode), and the button info, whether
  101.     ' or not there is a new event (position has changed or button pressed).
  102.     ' The info is returned through the event parameter passed to it.
  103.     ' Note: Calling this subroutine updates the last known values for the
  104.     ' position of the mouse pointer, so that even if the position IS new
  105.     ' (it has moved), then calling MouseMove after calling this will NOT
  106.     ' reveal the change in position, as you've chosen to ignore the move
  107.     ' by calling this subroutine.
  108.     ' Note: No debouncing at all is done in this subroutine.  It simply
  109.     ' gives you the current status of the buttons, without caring whether
  110.     ' any of them are pressed or not.
  111.  
  112.         IF mINIT = 0 THEN           ' Not initialized/available
  113.             EXIT SUB
  114.         END IF
  115.        
  116.         inreg.ax = 3
  117.         CALL INTERRUPT(&H33, inreg, outreg)     ' Get position/button info
  118.         IF mGRAPHICS = 0 THEN       ' Text mode
  119.             outreg.cx = INT(outreg.cx / 8) + 1
  120.             outreg.dx = INT(outreg.dx / 8) + 1
  121.         ELSEIF mGRAPHICS = 1 THEN   ' Graphics mode 1
  122.             outreg.cx = INT(outreg.cx / 2)
  123.         END IF
  124.         event.x = outreg.cx
  125.         event.y = outreg.dx
  126.         event.buttons = outreg.bx
  127.         mXlast = outreg.cx
  128.         mYlast = outreg.dx
  129.     END SUB
  130.  
  131.     SUB MouseGraphicsPtr (hotx AS INTEGER, hoty AS INTEGER, map AS BitMap)
  132.     ' ----------------------=< MouseGraphicsPtr >=------------------------
  133.     ' The graphics-mode version of MouseTextPrt.  You pass it the position
  134.     ' of the cursor hot-spot within the bitmap, and the actual 16 bit X
  135.     ' 16 bit bitmap you want to use as the new pointer shape, as well as a
  136.     ' similar such bitmap for the screen mask (this first gets ANDed with
  137.     ' what is on the screen where the pointer is, then the pointer's bitmap
  138.     ' gets XORed with the result of that).  There is a type defined (BitMap)
  139.     ' which contains the 32 integers (each 16 bits) necessary to hold both
  140.     ' of these bitmaps.
  141.  
  142.         IF mINIT = 0 OR mGRAPHICS = 0 THEN ' Not init., or in text mode
  143.             EXIT SUB
  144.         END IF
  145.  
  146.         inregx.ax = 9
  147.         inregx.bx = hotx
  148.         inregx.cx = hoty
  149.         inregx.dx = VARPTR(map)   ' location of variable; offset from segment
  150.         inregx.es = VARSEG(map)   ' location of variable's segment
  151.         CALL INTERRUPTX(&H33, inregx, outregx)  ' define graphics cursor
  152.     END SUB
  153.  
  154.     SUB MouseHide
  155.     ' ----------------------------=< MouseHide >=--------------------------
  156.     ' Hides the mouse pointer (shuts it off).  I advise hiding before every
  157.     ' CLS, then turning it back on with MouseShow after screen is fully
  158.     ' drawn (especially if changing screen color).  Otherwise, the pointer
  159.     ' may interfere with stuff being drawn on the screen.
  160.  
  161.         IF mINIT = 0 THEN           ' Not initialized/available
  162.             EXIT SUB
  163.         END IF
  164.  
  165.         inreg.ax = 2
  166.         CALL INTERRUPT(&H33, inreg, outreg)     ' Hide the pointer
  167.     END SUB
  168.  
  169.     FUNCTION MouseInit (mode AS INTEGER)
  170.     ' ---------------------------=< MouseInit >=---------------------------
  171.     ' Function which initializes the mouse for use.  The argument passed
  172.     ' should be 0 for normal text-mode (80 columns X 25 rows) screen, or
  173.     ' 1 for graphics-mode resolution 1 (320 X 200), or 2 for graphics-mode
  174.     ' resolution 2 (640 X 200; same as mouse's own virtual screen).  The
  175.     ' return value is 0 if no mouse is available for use, otherwise it i